home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / util / cli / check.lha / Check / Source / Check.p
Encoding:
Text File  |  1995-04-05  |  7.9 KB  |  255 lines
  1.  
  2. PROGRAM Check;
  3.  
  4. (**********************************)
  5. (*     Version 0.01   25.12.94    *)
  6. (*     Version 0.02   18.01.95    *)
  7. (*     Version 0.03   21.02.95    *)
  8. (*     Version 0.03   04.04.95    *)
  9. (*        (c) Stefan Diener       *)
  10. (* written with Maxon-Pascal 3.00 *)
  11. (*     by MAXON Computer GmbH     *)
  12. (**********************************)
  13.  
  14. (****************************************************)
  15. (*                                                  *)
  16. (*                    compiled at                   *)
  17. (*                                                  *)
  18. (* Modell     : Amiga 1200                          *)
  19. (* Kickstart  : 39.106 (Kick 3.0)                   *)
  20. (*                                                  *)
  21. (* CPU        : 68030, 50 MHz (incl. MMU)           *)
  22. (* FPU        : 68882, 50 MHz                       *)
  23. (* Turboboard : Blizzard 1230 Mk II                 *)
  24. (*                                                  *)
  25. (* Chip RAM   : 2 MByte                             *)
  26. (* Fast RAM   : 8 MByte                             *)
  27. (*                                                  *)
  28. (* Hardisk  1 : 210 MByte AT   - Seagate            *)
  29. (* Controller : internal (AT)                       *)
  30. (*                                                  *)
  31. (* Harddisk 2 : 540 MByte SCSI - Quantum Lightning  *)
  32. (* Controller : Blizzard 1230 SCSI-Kit              *)
  33. (*                                                  *)
  34. (* CD-ROM     : Double Speed   - Mitsumi FX 001 D   *)
  35. (* Controller : CD 1200 Controller (via PCMCIA)     *)
  36. (*                                                  *)
  37. (* Diskdrives : internal (DD)                       *)
  38. (*              external (HD)                       *)
  39. (*                                                  *)
  40. (****************************************************)
  41.  
  42. (**************************************************)
  43. (* Das Programm ermöglicht folgende Operationen : *)
  44. (* a) einzelne Dateien auf Fehler testen          *)
  45. (* b) für Verzeichnisse                           *)
  46. (*    1. Gesamtgröße feststellen                  *)
  47. (*    2. ev. jede Datei auf Fehler testen         *)
  48. (*    3. ev. rekursive Wiederholung für           *)
  49. (*       alle Unterverzeichnisse                  *)
  50. (**************************************************)
  51.  
  52. {$incl "dos.lib"}
  53.  
  54. CONST Empty = '                                                                                ';
  55.       Dummy = '$VER: Check 0.04 (04.04.95) Stefan Diener';
  56.  
  57. TYPE MyString = ARRAY [1..200] OF Char;
  58.  
  59. VAR Leer                   : Integer;
  60.     Summe, Temp            : Long;
  61.     Zaehl1, Zaehl2, Zaehl3 : Long;
  62.     LW                     : MyString;
  63.     Check, Modus, Quick    : Boolean;
  64.  
  65. PROCEDURE  Hilfe;
  66. (* Die Help-Seite ... *)
  67. BEGIN
  68.   WriteLn;
  69.   WriteLn('Check Version 0.04');
  70.   WriteLn('A simple file and directory scanner.');
  71.   WriteLn('(c) by Stefan Diener 1995');
  72.   WriteLn;
  73.   WriteLn('Check [-v] [-n] [-q] path|file');
  74.   WriteLn('  -v   : verify = file test');
  75.   WriteLn('  -n   : enter no subdirs');
  76.   WriteLn('  -q   : quick = minimal output');
  77.   WriteLn('  path : path to check');
  78.   Write('  file : single file to check');
  79.   Error('');
  80. END;
  81.  
  82. FUNCTION ReallyAFile(Wo:MyString):Boolean;
  83. (* Testet, ob es sich um eine echte Datei handelt. *)
  84. VAR Datei : File OF Byte;
  85. BEGIN
  86.   Reset(Datei,Wo);
  87.   IF IOResult=0 THEN BEGIN
  88.     Close(Datei);
  89.     ReallyAFile:=True;
  90.   END ELSE ReallyAFile:=False;
  91. END;
  92.  
  93. FUNCTION Punktiert(Zahl:Long):String;
  94. (* Ausgabe der Zahl im punktierten Dezimalformat *)
  95. VAR Kette1, Kette2 : String;
  96.     Laenge, Posi, count : Byte;
  97. BEGIN
  98.   Kette1:=IntStr(Zahl);
  99.   IF Zahl<1000 THEN Punktiert:=Kette1
  100.   ELSE BEGIN
  101.     Kette2:='';
  102.     Posi:=1;
  103.     Laenge:=Length(Kette1);
  104.     FOR count:=1 TO Laenge DO BEGIN
  105.       Kette2[Posi]:=Kette1[count];
  106.       IF (count<>Laenge) AND (Frac((Laenge-count)/3)=0) THEN BEGIN
  107.         Inc(Posi);
  108.         Kette2[Posi]:='.';
  109.       END;
  110.       Inc(Posi);
  111.     END;
  112.     Kette2[Posi]:=chr(0);
  113.     Punktiert:=Kette2;
  114.   END;
  115. END;
  116.  
  117. FUNCTION CheckIt(Name:MyString):Long;
  118. (* Verify wird auf eine Datei angewendet. *)
  119. (* Rückgabewert : gelesene Bytes *)
  120. VAR MyVal : Byte;
  121.     Datei  : File OF Byte;
  122.     Laenge : Long;
  123. BEGIN
  124.   Laenge:=0;
  125.   Reset(Datei,Name);
  126.   IF IOResult<>0 THEN BEGIN
  127.     Zaehl3:=Zaehl3+1;
  128.     IF NOT(Quick) THEN Write('  ERROR No.1');
  129.     CheckIt:=0;
  130.   END ELSE BEGIN
  131.     Buffer(Datei,50000);
  132.     While (NOT(EOF(Datei))) AND (IOResult=0) DO BEGIN
  133.       Read(Datei,MyVal);
  134.       Laenge:=Laenge+1;
  135.     END;
  136.     IF IOResult<>0 THEN BEGIN
  137.       Zaehl3:=Zaehl3+1;
  138.       IF NOT(Quick) THEN Write('  ERROR No.2');
  139.     END;
  140.     CheckIt:=Laenge;
  141.     Close(Datei);
  142.   END;
  143. END;
  144.  
  145. PROCEDURE NextDir(Name:MyString);
  146. (* Die Routine zum Directory-Scannen, rekursiv. *)
  147. VAR MyLock : BPTR;
  148.     FIB    : p_FileInfoBlock;
  149. BEGIN
  150.   MyLock:=Lock(Name,Shared_Lock);
  151.   IF MyLock=0 THEN BEGIN
  152.     IF NOT(Quick) THEN WriteLn('   No LOCK ! (File or path not found !!!)');
  153.     Zaehl3:=succ(Zaehl3);
  154.     Exit;
  155.   END;
  156.   New(FIB);
  157.   IF Examine(MyLock,FIB)=0 THEN BEGIN
  158.     IF NOT(Quick) THEN WriteLn('   No EXAMINE ! (DOS error !!!)');
  159.     UnLock(MyLock);
  160.     Zaehl3:=succ(Zaehl3);
  161.     UnLock(MyLock);
  162.     Exit;
  163.   END;
  164.   IF pos(':',Name)<>length(Name) THEN Name:=Name+'/';
  165.   Leer:=Leer+2;
  166.   While ExNext(MyLock,FIB)<>0 DO
  167.     IF FIB^.fib_DirEntryType>=0 THEN BEGIN
  168.       IF not(Modus) THEN BEGIN
  169.         Zaehl2:=succ(Zaehl2);
  170.         IF NOT(Quick) THEN WriteLn(Copy(Empty,1,Leer),'<DIR> ',FIB^.fib_FileName);
  171.         NextDir(Name+FIB^.fib_FileName);
  172.       END;
  173.     END ELSE BEGIN
  174.       IF NOT(Quick) THEN Write(Copy(Empty,1,Leer),FIB^.fib_FileName);
  175.       Zaehl1:=succ(Zaehl1);
  176.       IF Check THEN Temp:=CheckIt(Name+FIB^.fib_FileName)
  177.         ELSE Temp:=FIB^.fib_size;
  178.       Summe:=Summe+Temp;
  179.       IF NOT(Quick) THEN WriteLn('  (',Temp,')');
  180.     END;
  181.   UnLock(MyLock);
  182.   Dispose(FIB);
  183.   Leer:=Leer-2;
  184. END;
  185.  
  186. PROCEDURE ReadCommands;
  187. (* Kommandozeile auswerten. *)
  188. VAR Text : MyString;
  189. BEGIN
  190.   IF ParameterLen<2 THEN Hilfe;
  191.   Text:=Copy(ParameterStr,1,ParameterLen-1);
  192.   IF Text='' THEN Hilfe;
  193.   While (ord(Text[length(Text)])<33) DO Delete(Text,length(Text),1);
  194.   IF Text='' THEN Hilfe;
  195.   While (ord(Text[1])<33) DO Delete(Text,1,1);
  196.   IF (Text='?') OR (Text='') THEN Hilfe;
  197.   Modus:=False;
  198.   Check:=False;
  199.   Quick:=False;
  200.   While Text[1]='-' DO BEGIN
  201.     Delete(Text,1,1);
  202.     IF Text='' THEN Hilfe;
  203.     CASE UpCase(Text[1]) OF
  204.       'V' : Check:=True;
  205.       'N' : Modus:=True;
  206.       'Q' : Quick:=True;
  207.       Otherwise BEGIN
  208.         WriteLn;
  209.         WriteLn('Parsing error : Unknown option !');
  210.         Hilfe;
  211.       END;
  212.     END;
  213.     Delete(Text,1,1);
  214.     IF Text='' THEN Hilfe;
  215.     While (ord(Text[1])<33) DO Delete(Text,1,1);
  216.     IF Text='' THEN Hilfe;
  217.   END;
  218.   LW:=Text;
  219. END;
  220.  
  221. (* MAIN-Part *)
  222. BEGIN                               (* Hier geht's los. *)
  223.   IF FromWB THEN Exit;              (* CLI-ONLY, sorry ! *)
  224.   ReadCommands;                     (* Kommandos auswerten *)
  225.   IF NOT(Quick) THEN WriteLn;       (* noch ein bischen Initialisierung *)
  226.   Leer:=-2;
  227.   Zaehl1:=0;
  228.   Zaehl2:=0;
  229.   Zaehl3:=0;
  230.   Summe:=0;
  231.   IF ReallyAFile(LW) THEN BEGIN     (* wenn's eine Datei ist ... *)
  232.     Write(LW);
  233.     IF Check THEN Summe:=CheckIt(LW);    (* eventuell Verify ausführen *)
  234.     WriteLn;
  235.     WriteLn;
  236.     Write('1 file ');               (* Auswertung *)
  237.     IF Check THEN WriteLn('checked.')
  238.       ELSE WriteLn('found (but not checked) !');
  239.     IF Zaehl3=0 THEN WriteLn('No errors detected.')
  240.       ELSE WriteLn(Zaehl3,' errors found !');
  241.   END ELSE BEGIN                    (* wenn's keine Datei war ... *)
  242.     NextDir(LW);                    (* Verzeichnis lesen, ev. rekursiv *)
  243.     WriteLn;                        (* Auswertung *)
  244.     Write(Punktiert(Zaehl1),' files and ',Punktiert(Zaehl2), ' directories');
  245.     IF Check THEN Write(' checked');
  246.     WriteLn('.');
  247.     IF Zaehl3=0 THEN WriteLn('No errors detected.')
  248.       ELSE WriteLn(Zaehl3,' errors found !');
  249.   END;
  250.   WriteLn('Bytes passed : ',Punktiert(Summe));      (* gefundene Bytes *)
  251.   WriteLn;
  252.   DisposeAll;                       (* Speicher freigeben *)
  253. END.                                (* Und tschüß ! *)
  254.  
  255.